home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / intstrmap.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  3.1 KB  |  96 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. structure IntStrMap : INTSTRMAP =
  3. struct
  4.   open Array List
  5.   infix 9 sub
  6.  
  7.   datatype 'a bucket = NIL | B of (int * string * 'a * 'a bucket)
  8.   datatype 'a intstrmap =
  9.     H of {table: 'a bucket array ref,elems: int ref,exn: exn,name: string option}
  10.   fun bucketapp f =
  11.       let fun loop NIL = ()
  12.         | loop(B(i,s,j,r)) = (f(i,s,j); loop r)
  13.       in loop
  14.       end
  15.   fun roundsize size = 
  16.       let fun f x = if x >= size then x else f (x*2)
  17.       in f 1
  18.       end
  19.   fun namednew(name, size, exn) =
  20.       H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,
  21.      name=SOME name}
  22.   fun new(size, exn) =
  23.       H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,name=NONE}
  24.   val elems = fn (H{elems,...}) => !elems
  25.   fun map (H{table,exn,...}) =
  26.       let fun find(i,s,NIL) = raise exn
  27.             | find(i,s,B(i',s',j,r)) = if i=i' andalso s=s' then j else find(i,s,r)
  28.       fun map' (i,s) = let val ref a = table
  29.                in find (i,s,a sub Bits.andb(i,(Array.length a)-1))
  30.                end
  31.       in map'
  32.       end
  33.   fun rmv (H{table=ref a,elems,...}) (i,s) =
  34.       let fun f(B(i',s',j,r)) =
  35.             if i=i' andalso s=s' then (dec elems; r) else B(i',s',j,f r)
  36.         | f x = x
  37.       val index = Bits.andb(i,(Array.length a)-1)
  38.       in  update(a, index, f(a sub index))
  39.       end
  40.   fun app f (H{table=ref a,...}) =
  41.       let fun zap 0 = ()
  42.         | zap n = let val m = n-1 in bucketapp f (a sub m); zap m end
  43.       in  zap(Array.length a)
  44.       end
  45.   fun add (m as H{table as ref a, elems, name, ...}) (v as (i,s,j)) =
  46.       let val size = Array.length a
  47.        in if !elems <> size
  48.       then let val index = Bits.andb(i, size-1)
  49.            fun f(B(i',s',j',r)) =
  50.                  if i=i' andalso s=s' then B(i,s,j,r) else B(i',s',j',f r)
  51.              | f x = (inc elems; B(i,s,j,x))
  52.            in update(a,index,f(a sub index))
  53.            end
  54.       else let val newsize = size+size
  55.            val newsize1 = newsize-1
  56.            val new = array(newsize,NIL)
  57.            fun bucket n =
  58.                let fun add'(a,b,B(i,s,j,r)) =
  59.                    if Bits.andb(i,newsize1) = n
  60.                    then add'(B(i,s,j,a),b,r)
  61.                    else add'(a,B(i,s,j,b),r)
  62.                  | add'(a,b,NIL) = 
  63.                    (update(new,n,a);
  64.                 update(new,n+size,b);
  65.                 bucket(n+1))
  66.                in add'(NIL,NIL,a sub n)
  67.                end
  68.            in (case name of
  69.              NONE => ()
  70.            | SOME name =>
  71.              List.app System.Print.say[
  72.                  "\nIncreasing size of intstrmap ", name, " to: ",
  73.                  makestring newsize, "\n"]);
  74.           bucket 0 handle Subscript => ();
  75.           table := new;
  76.           add m v
  77.            end
  78.       end
  79.   fun intStrMapToList(H{table,...})=
  80.       let val a = !table;
  81.       val last = Array.length a - 1
  82.       fun loop (0, NIL, acc) = acc
  83.       |   loop (n, B(i,s,j,r), acc) = loop(n, r, (i,s,j)::acc)
  84.       |   loop (n, NIL, acc) = loop(n-1, a sub (n-1), acc)
  85.        in loop(last,a sub last,[])
  86.       end
  87.   fun transform (f:'a -> '2b) (H{table=ref a, elems=ref n, exn, name}) =
  88.       let val newa = array(Array.length a,NIL)
  89.       fun mapbucket NIL = NIL
  90.         | mapbucket(B(i,s,x,b)) = B(i,s,f x,mapbucket b)
  91.       fun loop i = (update(newa,i,mapbucket(a sub i)); loop(i+1))
  92.        in loop 0 handle Subscript => ();
  93.       H{table=ref newa, elems=ref n, exn=exn, name=name}
  94.       end
  95. end
  96.